home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The Arsenal Files 6
/
The Arsenal Files 6 (Arsenal Computer).ISO
/
prg_basi
/
loadname.zip
/
LOADNAME.BAS
< prev
Wrap
BASIC Source File
|
1996-03-27
|
9KB
|
225 lines
'***********************************************************************
'* FILE LOADNAME.BAS
'* Released 27 Mar 1996.
'*
'* PURPOSE
'* Demonstrates loading filenames into an array by calling DOS ISR
'* 21H, Function 1AH (DOS set DTA Service), Function 4EH (Find First
'* Matching Name), and Function 4FH (Find Next Matching Name).
'*
'* NOTE
'* This code is for QuickBASIC which does not offer a way to
'* dynamically re-size an array without losing the contents (ala
'* PDS's REDIM PRESERVE). Therefore, SUB LoadNames first calls
'* FUNCTION FileCnt% to get a count of the matching filenames (to
'* determine the number of elements to which to dimension the
'* filename array).
'*
'* However, the observant will notice that much of the code in
'* FUNCTION FileCnt% is duplicated in SUB LoadNames. If you have
'* PDS, you can modify SUB LoadNames to use REDIM PRESERVE to
'* dynamically "grow" the array, rather than having to first call
'* FUNCTION FileCnt% to find out how many files match the given
'* filespec.
'*
'* WARRANTY
'* Joe Negron disclaims all warranties regarding this software,
'* whether express or implied, including, but not limited to,
'* warranties of merchantability, fitness for a particular purpose,
'* or functionality.
'*
'* LICENSE AGREEMENT
'* This source code is released to the Public Domain. However, an
'* acknowledgement in your documentation will be appreciated. You
'* may also, as a further courtesy, give me a registered copy of the
'* program in which this code is used; please leave me a message (see
'* CONTACTING THE AUTHOR) should you decide to do this.
'*
'* I encourage those to whom this code proves useful (and those to
'* whom it does not) to consider making a donation to their preferred
'* charity.
'*
'* ACKNOWLEDGEMENTS
'* My wife, Ana, for allowing me to spend countless hours at the PC.
'*
'* CONTACTING THE AUTHOR
'* If you have any comments, constructive criticism, bug fixes or
'* enhancements to offer, you may communicate with me in a variety
'* of ways (in order of preference):
'*
'* 1. If you have access to FidoNet NetMail, route or crash a
'* message to Joe Negron at 1:278/216.
'*
'* 2. Log onto my BBS:
'*
'* The Programmer's Mark BBS, 1:278/216@fidonet
'* (718) 921-9267
'* Brooklyn, NY, USA
'* Joe Negron, Sysop
'* John Bragazzi, Co-Sysop
'* Running Maximus/2 v3.01
'* Available 24 hours/day, 7 days/wk
'*
'* and leave a message in message area JNEGRON, Support for Joe
'* Negron Products.
'*
'* 3. If you have access to the Internet, leave a message,
'* addressed to "joe.negron@consultant.com".
'*
'* 4. Via snail mail:
'*
'* Joe Negron
'* P.O. Box 09546
'* Fort Hamilton Station
'* Brooklyn, NY 11209
'***********************************************************************
DEFINT A-Z
DECLARE SUB LoadNames (FileSpec$, Array$(), Attr%)
DECLARE FUNCTION FileCnt% (FileSpec$, Attr%)
'$INCLUDE: 'qb.bi' 'Needed for Interrupt call
TYPE DTARec 'used by Find First/Next
Reserved AS STRING * 21
Attr AS STRING * 1
NotNeeded AS STRING * 8 'Time/date/size (unneeded)
FileName AS STRING * 13
END TYPE
DIM SHARED DTA AS DTARec 'SHARED lets both SUB
DIM SHARED RegsX AS RegTypeX ' LoadNames and FUNCTION
' FileCnt% access them.
'Use COMMON SHARED to allow
' access from multiple
' modules
REDIM FileName$(1 TO 1) 'Create a dynamic arrray
Spec$ = "C:\*.*" 'Load filenames matching
' this filespec
'Note: this code does NOT return files with
'the Hidden, System, or Read-Only attributtes
Attr% = 16 'Directories only
Attr% = 32 'Files only
Attr% = 48 'Files and Directories
LoadNames Spec$, FileName$(), Attr%
'Show what we've found
IF FileName$(1) = "" THEN
PRINT "No matching files"
ELSE
FOR I% = 1 TO UBOUND(FileName$)
PRINT USING "###: \ \"; I%; FileName$(I%)
NEXT I%
END IF
END
'***********************************************************************
'* FUNCTION FileCnt%
'*
'* PURPOSE
'* Uses DOS ISR 21H, Function 1AH (DOS set DTA Service), Function 4EH
'* (Find First Matching Name), and Function 4FH (Find Next Matching
'* Name) to obtain a count of files matching FileSpec$.
'***********************************************************************
FUNCTION FileCnt% (FileSpec$, Attr%) STATIC
RegsX.dx = VARPTR(DTA) 'Set new DTA address
RegsX.ds = -1 'DTA is in DGROUP
RegsX.ax = &H1A00 'Set DTA
InterruptX &H21, RegsX, RegsX 'Call DOS
Count% = 0 'Initialize counter
FBuff$ = FileSpec$ + CHR$(0) 'Needs to be ASCIIZ string
RegsX.cx = Attr% 'Files matching Attr%
RegsX.dx = SADD(FBuff$) 'FBuff$'s address
RegsX.ds = -1 'For QuickBASIC, segment is
' always DGROUP
RegsX.ax = &H4E00 'Find First Matching Name
DO
InterruptX &H21, RegsX, RegsX 'Call DOS
IF RegsX.flags AND 1 THEN 'Error flag
EXIT DO 'No more files
END IF
SELECT CASE Attr% 'Which attrs. to include?
CASE 16 'Count only directories?
IF (ASC(DTA.Attr) \ 16) AND 1 THEN 'Is this one a directory?
IF ASC(DTA.FileName) <> 46 THEN 'Ignore "." and ".."
Count% = Count% + 1 'Found another dir name
END IF
END IF
CASE 0, 32 'Count count only files?
Count% = Count% + 1 'Found another file name
CASE 48 'Count files & directories
Count% = Count% + 1
END SELECT
RegsX.ax = &H4F00 'Find next name service
LOOP
FileCnt% = Count% 'Assign value to function
END FUNCTION
'***********************************************************************
'* SUB LoadNames
'*
'* PURPOSE
'* Uses DOS ISR 21H, Function 1AH (DOS set DTA Service), Function 4EH
'* (Find First Matching Name), and Function 4FH (Find Next Matching
'* Name) to load the files matching FileSpec$ into an array.
'***********************************************************************
SUB LoadNames (FileSpec$, Array$(), Attr%) STATIC
Spec$ = FileSpec$ + CHR$(0) 'Needs to be ASCIIZ string
NumFiles% = FileCnt%(Spec$, Attr%) 'Get # files matching Spec$
IF NumFiles% = 0 THEN 'If there are none,
EXIT SUB ' exit
END IF
REDIM Array$(1 TO NumFiles%) 'Allocate enough elements
RegsX.dx = SADD(Spec$) 'Filespec's address
RegsX.ds = VARSEG(Spec$)
RegsX.cx = Attr%
RegsX.ax = &H4E00 'Find First Matching Name
Count% = 0 'Initialize the counter
DO
InterruptX &H21, RegsX, RegsX 'Call DOS
IF RegsX.flags AND 1 THEN 'Error flag
EXIT DO 'No more files
END IF
Valid% = 0 'Assume invalid
SELECT CASE Attr% 'Which attrs. to include?
CASE 16 'Count only directories?
IF (ASC(DTA.Attr) \ 16) AND 1 THEN 'Is this one a directory?
IF ASC(DTA.FileName) <> 46 THEN 'Ignore "." and ".."
Valid% = -1 'Found another dir name
END IF
END IF
CASE 0, 32 'Count only files?
Valid% = -1 'Found another file name
CASE 48 'Count files & directories
Valid% = -1
END SELECT
IF Valid% THEN 'Add the file to array if
Count% = Count% + 1 ' it's valid
Z% = INSTR(DTA.FileName, CHR$(0)) 'Find terminating NUL
Array$(Count%) = LEFT$(DTA.FileName, Z% - 1) 'assign the name
END IF
RegsX.ax = &H4F00 'Find Next Matching Name
LOOP
END SUB